﻿module Program

open System
open System.IO
open System.Diagnostics
open System.ComponentModel
open Microsoft.Office.Interop.Excel
open Microsoft.Vbe.Interop
open Microsoft.FSharp.Text.Lexing
open System.Text.RegularExpressions
open System.Collections.Generic
open Common
open Ast
open System.Text
open Lexer
open Parser


type TipoFonte = |Fixed |TXT |Custom
type Fonte = {Tipo:TipoFonte; Source:string}

type Info = {Form:Ast.Formula; Dip: string list}
let cellsInfo = new Dictionary<string, Info>(47)

let private fatto = new HashSet<string>() // elements already printed
let maybeInputs = Dictionary<string, Fonte>()

let app = ApplicationClass( 
             Visible=false,
             DisplayAlerts=false
          )

let rec private printGroup (rng:string) (tw:TextWriter) =
    if not (fatto.Contains(rng)) then
        // Stampa le sottodipendenze
        let myDipWin = myGeneralized.[rng]
        for coloumn in myDipWin.Dip do
            if not(fatto.Contains(coloumn)) then
                if myInputs.ContainsKey(coloumn) then
                    printCell (Common.myInputs.[coloumn]) (tw)
                elif myGeneralized.ContainsKey(coloumn) then
                    printGroup (coloumn) tw
                else
                    printCell coloumn tw
        // Stampa la generalizzazione del range
        let sh = rng.Split('!')
        let first = sh.[0] + "!" + sh.[1].Split(':').[0]

        tw.WriteLine("let "+(rng2var rng)+" = ")
        tw.WriteLine("    { new IRange with "+Environment.NewLine+
                        "        member this.ValueSeq() ="+Environment.NewLine+
                        "            seq{")
        for i in 0..myDipWin.Dip.Length-1 do
            let name = if myInputs.ContainsKey(myDipWin.Dip.[i]) then myInputs.[myDipWin.Dip.[i]] else rng2var (myDipWin.Dip.[i])
            tw.WriteLine("                let t_"+(rng2var myDipWin.Dip.[i])+" = (Seq.windowed "+myDipWin.RelativeWinSz.[i].ToString()+" ("+name+".ValueSeq())).GetEnumerator()")
        
        let mutable temp = new StringBuilder()
        tw.Write("                while (")
        for d in myDipWin.Dip do
            temp <- temp.Append(" t_").Append(rng2var d).Append(".MoveNext() &&")
        temp<-temp.Remove(temp.Length-3,3)  // remove fianl "&&"
        tw.WriteLine(temp.ToString() + " ) do")

        tw.WriteLine("                    yield box ("+ (cellsInfo.[first].Form.Eval (EvalType.Generalized(myDipWin))) + ")" + Environment.NewLine +
                        "            }" + Environment.NewLine +
                        "        member this.Values() = " + Environment.NewLine +
                        "            array2D (seq{ yield (this.ValueSeq()) } )" + Environment.NewLine +
                        "    }"
                    )
        fatto.Add(rng) |>ignore


and private printCell (key:string) (tw:TextWriter) =
    if not (fatto.Contains key) then
        let cel = cellsInfo.[key]
        
        for ds in cel.Dip do
            for vert in Common.columnsFromRng ds do
                if myInputs.ContainsKey(vert) then
                    printCell (Common.myInputs.[vert]) tw
                elif myGeneralized.ContainsKey(vert) then
                    printGroup vert tw
                else
                    for d in Common.cellsFromColumn vert do
                        if not (fatto.Contains(d)) then
                            printCell d tw
                            fatto.Add(d) |>ignore

        let celName = rng2var key
        tw.WriteLine("let "+celName+" = "+(cel.Form.Eval (EvalType.Complete))+
                     Environment.NewLine + "wbk.Add(\""+celName+"\","+celName+")" )
        fatto.Add(key)|>ignore



/// Dato il valore di una cella, restituisce la stringa contenente il valore con il tipo corretto...
let manageDataType(cell:Range) =
    if cell.Value2 = null then "0."//"@\"\""
    else
        let mutable v = 0.
        if System.Double.TryParse(cell.Value2.ToString(), &v) then
            let fmt = cell.NumberFormat.ToString()  
            if fmt.Contains("d") || fmt.Contains("m") || fmt.Contains("y") || fmt.Contains("h") || fmt.Contains("s") then
                "DateTime.FromOADate(float " + cell.Value2.ToString().Replace(",",".")+")"
            else
                "float "+ cell.Value2.ToString().Replace(",",".")
        else
            "@\"" + cell.Value2.ToString().Replace("\"","\"\"") + "\""
    // endif


let thumbs = new Dictionary<string, Drawing.Image>()
let getThumbs (cells:Range) =
    try
        cells.Worksheet.Select()
        cells.Select() |>ignore
        app.Visible <- true
        // let hWnd = new IntPtr( Native.FindWindow("XLMAIN", null) )
        let img = Native.GetImage(nativeint (app.Hwnd))
        app.Visible <- false
        img
    with |_ -> null

let rec checkCells(cells:Range) =
    let mutable canInput = true
    let mutable canGeneralized = true

    if cells.Count=1 then
        let c0 = cells.[1]:?>Range
        Common.currentCell <- c0.Address(false,false,XlReferenceStyle.xlA1,true).Split(']').[1]
        printfn "  Get: %s" Common.currentCell
            
        if not (cellsInfo.ContainsKey(Common.currentCell) ) then   // se la cella non è stata ancora visitata..
            let formula = c0.Formula.ToString()
            if formula.StartsWith "=" then
                Common.resetInfo()
                let lexbuff = LexBuffer<char>.FromString (formula.Substring 1)
                let tree = Parser.start (Lexer.tokenize) lexbuff
                let currCell,currDip = Common.currentCell,Common.currentDip
                if not (currDip.IsEmpty) then
                    canInput<-false
                    for d in currDip do 
                        let r = d.Split('!')    // la prox istruzione invalida Common..
                        checkCells ((wbk.Worksheets.[r.[0]]:?>Worksheet).Range(r.[1])) |>ignore
                cellsInfo.Add(currCell, {Form = tree; Dip = currDip} )
            else
                cellsInfo.Add(Common.currentCell, {Form = ConstCell(manageDataType c0); Dip = List.empty })
        
        if canInput then
            let addr = cells.Address(false,false,XlReferenceStyle.xlA1,true).Split(']').[1]
            if not (maybeInputs.ContainsKey(addr)) then
                thumbs.Add(addr, getThumbs(cells) )
                maybeInputs.Add(addr, {Tipo=Fixed; Source="" })|>ignore
            
        canGeneralized<-false
    else  // cells.Count>1 
           
        for j in 1..cells.Columns.Count do
            let key = (cells.Columns.[j] :?> Range).Address(false,false,XlReferenceStyle.xlA1,true).Split(']').[1]
            
            if Common.myGeneralized.ContainsKey(key) || maybeInputs.ContainsKey(key) then
                canGeneralized<-true
            else
                let mutable allDip:string list = List.empty
                let c0 = cells.Cells.[1,j] :?> Range
                Common.currentCell <- c0.Address(false,false,XlReferenceStyle.xlA1,true).Split(']').[1]
                printfn "  Get: %s" Common.currentCell

                let firstInfo = 
                    if (cellsInfo.ContainsKey(Common.currentCell) ) then
                        let temp = (cellsInfo.[Common.currentCell])
                        allDip <- temp.Dip @ allDip
                        temp
                    else
                        let formula = c0.Formula.ToString()
                        if formula.StartsWith "=" then
                            Common.resetInfo()
                            let lexbuff = LexBuffer<char>.FromString (formula.Substring 1)
                            let firstree = Parser.start (Lexer.tokenize) lexbuff
                            let temp = {Form=firstree; Dip=Common.currentDip}
                            cellsInfo.Add(Common.currentCell, temp)
                            allDip <- Common.currentDip @ allDip
                            temp
                        else
                            let temp = {Form = ConstCell(manageDataType c0); Dip=List.empty}
                            cellsInfo.Add(Common.currentCell, temp)
                            temp

                for i in 2..((cells.Columns.[j]:?>Range).Rows.Count) do
                    let c = cells.Cells.[i,j] :?> Range
                    Common.currentCell <- c.Address(false,false,XlReferenceStyle.xlA1,true).Split(']').[1]
                    printfn "  Get: %s" Common.currentCell
                    if (cellsInfo.ContainsKey(Common.currentCell) ) then
                        let temp = (cellsInfo.[Common.currentCell])
                        allDip <- temp.Dip @ allDip
                    else
                        let formula = c.Formula.ToString()
                        if formula.StartsWith "=" then
                            Common.resetInfo()
                            let lexbuff = LexBuffer<char>.FromString (formula.Substring 1)
                            let tree:Ast.Formula = Parser.start (Lexer.tokenize) lexbuff
                            if not (tree.dragged (firstInfo.Form) (i-1)) then
                                canGeneralized<-false
                            cellsInfo.Add(Common.currentCell, {Form = tree; Dip=Common.currentDip})
                            allDip <- Common.currentDip @ allDip
                        else
                            cellsInfo.Add(Common.currentCell, {Form=ConstCell(manageDataType c); Dip=List.empty})
                
                Common.currentCell <- null
                if not (allDip.IsEmpty) then
                    canInput <- false

                    let r = allDip.[0].Split('!')
                    let mutable myRng = (wbk.Worksheets.[r.[0]]:?>Worksheet).Range(r.[1])
                    for i in 1..allDip.Length-1 do    // TODO: ottimizzaz. 10 per volta
                        let r = allDip.[i].Split('!')
                        myRng <- app.Union(myRng, ((wbk.Worksheets.[r.[0]]:?>Worksheet).Range(r.[1])) )
                    
                    let mutable vertDip = List.empty
                    for area in myRng.Areas do
                        if not (checkCells area) then canGeneralized<-false
                        let addr = area.Address(false,false,XlReferenceStyle.xlA1,true).Split(']').[1]
                        for column in Common.columnsFromRng addr do
                            vertDip <- column :: vertDip

                    if canGeneralized then
                        let rngDip = List.toArray vertDip
                        let rngWinSize = Array.create rngDip.Length 1
                        
                        for dip in firstInfo.Dip do
                            for d in Common.columnsFromRng dip do
                                let maxCell = 
                                    let sh=d.Split('!')
                                    let el=sh.[1].Split(':')
                                    if el.Length=1 then d else sh.[0]+"!"+el.[1]
                                let index,height = Common.cellWithinRanges maxCell rngDip
                                if height+1>rngWinSize.[index] then rngWinSize.[index]<-height+1
                        
                        myGeneralized.Add(key, {Dip=rngDip; RelativeWinSz=rngWinSize})
                else // computation input
                    maybeInputs.Add(key, {Tipo=Fixed; Source=""})
                    thumbs.Add(key, getThumbs(c0))
        //end columns-cycle  
    canGeneralized


let mutable myOutput: (string*string) list = List.empty  // (cell*comment) list
let mutable myVBAcode:string = null

// Gestione Macro
let saveVBAcode () =
    printf "\n\r>>> Macro functions: "
    try
        myVBAcode <- null
        for vbc in wbk.VBProject.VBComponents do
            if vbc<>null then
                let count = vbc.CodeModule.CountOfLines
                if count>0 then
                    myVBAcode <- myVBAcode + 
                                    "' ##### "+ vbc.Name +
                                    vbc.CodeModule.Lines(1,count)
        if myVBAcode=null then printfn "None" else printfn "Saved"
    with 
        |ex -> printfn "ERROR: %s %s   [skipped]" ex.Message Environment.NewLine

let collector (path: string) =    
    Common.wbk <- app.Workbooks.Open(path, 2, true)    // true=read-only
    app.Calculation <- XlCalculation.xlCalculationManual
    
    try
        app.WindowState<- XlWindowState.xlNormal
        app.Left <- -600.
        app.Top  <- -600.
        app.Width <- 500.
        app.Height <- 500.
    with | _ -> ()

    printfn ">>> Search output cells.."

    app.FindFormat.Font.Color <- 255
    let mutable redCell:Range = null
    let mutable first = null
    for s1 in wbk.Sheets do
        let s = (s1 :?> Worksheet)
        if not ( Regex.IsMatch(s.Name, "^[a-zA-Z_][a-zA-Z0-9_]*$") ) then
            failwith ("Invalid worksheet name: "+s.Name)
        elif s.CircularReference<>null then
            failwith ("Circular reference in the sheet "+s.Name)

        redCell <- s.Cells.Find("*", Type.Missing, Type.Missing, Type.Missing, XlSearchOrder.xlByColumns, XlSearchDirection.xlNext, Type.Missing, Type.Missing, true)
        first <- if redCell<>null then
                     let addr = redCell.Address(false,false,XlReferenceStyle.xlA1,true).Split(']').[1]
                     myOutput <- (addr, (if redCell.Comment<>null then redCell.Comment.Text().Trim() else addr) ) :: myOutput 
                     addr
                 else null
    
        let mutable search = redCell<>null
        while search do
            try
                checkCells (redCell) |>ignore
            with
                | ex -> printfn "%s \r\n %s" ex.Message ex.StackTrace
            
            redCell <- s.Cells.Find("*", redCell, Type.Missing, Type.Missing, XlSearchOrder.xlByColumns, XlSearchDirection.xlNext, Type.Missing, Type.Missing, true)
            let addr = redCell.Address(false,false,XlReferenceStyle.xlA1,true).Split(']').[1]
            if addr.Equals(first) then search<-false
            else myOutput<-(addr, (if redCell.Comment<>null then redCell.Comment.Text().Trim() else addr) ) :: myOutput
        //end while
    //end sheets loop
    redCell<-null; first<-null
    saveVBAcode()
    app.Quit()

let changeInputs() =    
    for input in maybeInputs do
        match input.Value.Tipo with
         | Fixed  -> if input.Key.Contains(":") then
                        cellsInfo.Add(input.Key, { Form = (ConstCell ("Range(\""+input.Key+"\") :> IRange") );
                                                    Dip  = Seq.toList(Common.cellsFromColumn input.Key) 
                                                 } )
                        // TODO: gestione single value
         | Custom -> let name = getNewInputName()
                     Common.myInputs.Add(input.Key, name)
                     let code = Environment.NewLine+"    "+input.Value.Source.Replace(Environment.NewLine, Environment.NewLine+"    ")
                     cellsInfo.Add(name, {Form = ConstCell(code); Dip = List.empty })
         | TXT   ->  let name = getNewInputName()
                     Common.myInputs.Add(input.Key, name)
                     let code = "new RangeTXT(@\""+input.Value.Source+"\") :> IRange"
                     cellsInfo.Add(name, {Form = ConstCell(code); Dip = List.empty })         
    maybeInputs.Clear()
    for gen in myGeneralized do 
        printfn " -> Generalized  %s " gen.Key    
 
 
let Compile (path:string) =
    let mainfs = File.CreateText (String.Format(@"{0}\program1.fs", path) )
    mainfs.WriteLine( "open System"+ Environment.NewLine +
                      "open Spreadsheet" + Environment.NewLine +
                      "open SSfunc"+ Environment.NewLine +
                      "let inline ( *- ) x y = x*(-y)" + Environment.NewLine+
                      "let inline ( /- ) x y = x/(-y)" + Environment.NewLine+
                      "let inline ( **- ) x y = x**(-y)"+ Environment.NewLine+
                      "let inline ( <+> ) x y = x.ToString()+y.ToString()"+ Environment.NewLine
                    )
    
    myOutput <- List.rev myOutput
    for el in myOutput do
        printCell (fst el) mainfs

    for el in myOutput do
        let ris = if myInputs.ContainsKey(fst el) then myInputs.[fst el] else (fst el)
        mainfs.WriteLine("printfn @\"" + (snd el).Replace("\"","\"\"") + "\t: %O\" " + ris.Replace('!','_'))
    myOutput<-List.Empty

    mainfs.WriteLine("Console.ReadKey(true) |> ignore")
    mainfs.Close()    
    cellsInfo.Clear()
    fatto.Clear()

    // Gestione stub functions
    if Common.myStubs.Count>0 then
        printfn "# Stub functions found..."
        use sw = File.CreateText (String.Format(@"{0}\stubs.fs", path) )
        sw.WriteLine( "module Stubs"+Environment.NewLine+"open Spreadsheet"+Environment.NewLine )
        for s in Common.myStubs do 
            sw.WriteLine("let "+s+" (param:obj list) = nan")
    
    // VBA code
    if myVBAcode<>null then
        using (File.CreateText (String.Format(@"{0}\macros.vba", path)))
              (fun file -> file.WriteLine(myVBAcode) )        

    // Compilation..
    printf "%s>>>>> Compilation: " Environment.NewLine

    let fs = new Microsoft.FSharp.Compiler.CodeDom.FSharpCodeProvider()
    let param = new System.CodeDom.Compiler.CompilerParameters(
                 [|  @"C:\Program Files\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.0\Profile\Client\mscorlib.dll";
                     @"System.dll"; @"System.Core.dll"; @"SSClib.dll" |] )
    param.CompilerOptions <- "--optimize"
    param.GenerateExecutable <- true
    param.OutputAssembly <- String.Format(@"{0}\program.exe",path)
 
    let cr = fs.CompileAssemblyFromFile(param, [| String.Format(@"{0}\program1.fs",path) |])
    printfn "%s" (if cr.Errors.HasErrors then "ERROR" else "OK")
    for e in cr.Errors do printfn "    Line %d: %s" e.Line e.ErrorText
    if (cr.Errors.HasErrors) then failwith "Compilation ERROR"